unit SkinTools;

interface

Uses
  Windows, SysUtils, Classes, Controls, Graphics, DB, ActnList,
  bsSkinData, bsSkinBoxCtrls, bsSkinCtrls, bsDbGrids, BusinessSkinForm,
  bsSkinGrids;

Type
  TValorTabla = string[3];  {ShortString de 3 caracteres (4 bytes)}

function PtrToValorTabla( p: pointer ): TValorTabla;
function ValorTablaToPtr( v : TValorTabla ): pointer;

Procedure SkinDataAssign(unControl:TComponent;SkinData:TbsSkinData);
function SkinComboBoxToStr( cb: TbsSkinCustomComboBox; const default: string= '' ): string;
procedure StrToSkinComboBox( cb: TbsSkinCustomComboBox; const val: string; default: integer= -1 );
function SkinComboBoxToObject( cb: TbsSkinCustomComboBox; const default: pointer= nil ): pointer;
procedure ObjectToSkinComboBox( cb: TbsSkinCustomComboBox; obj: pointer; default: integer= -1 );
function SkinComboBoxToInteger( cb: TbsSkinCustomComboBox; const default: integer= 0 ): integer;
procedure IntegerToSkinComboBox( cb: TbsSkinCustomComboBox; val: integer; default: integer= -1 );
function SkinComboBoxToValorTabla( cb: TbsSkinCustomComboBox; const default: TValorTabla= '' ): TValorTabla;
procedure ValorTablaToSkinComboBox( cb: TbsSkinCustomComboBox; val: TValorTabla; default: integer= -1 );

function  SkinDBGridStateToStr( DBGrid: TbsSkinDbgrid ): string;
procedure StrToSkinDBGridState( DBGrid: TbsSkinDbgrid; var s: string );

{OJO: Esta rutina es dependiente de la implementacion de TbsBusinessSkinForm. Revisar cuando se cambie la version de los Skins !!!!!}
procedure ClearBusinessSkinFormIcon(b: TbsBusinessSkinForm);

procedure SetSkinComboBoxDropWidth(CB: TbsSkinComboBox);

procedure CopySkinDBGridToClipboard( Grid: TbsSkinCustomDBGrid );
procedure CopySkinStringGridToClipboard( Grid: TbsSkinStringGrid; OnlySelection: boolean= false );

Procedure ObtenerPosicionesCentrado(rec:Trect;ancho,alto:integer; var posLeft,PosTop:integer);

function FindAction( al: TActionList; na: string ): integer;
procedure MakeToolBar( TBMain: TbsSkinToolbar; ALMain: TActionList; def: string );
function FindToolBarButton(TBMain: TbsSkinToolbar; a: TBasicAction): TbsSkinSpeedButton;
function ToolBarDefinition( TBMain: TbsSkinToolbar ): string;

implementation

uses
  TypInfo, Clipbrd, StrTools, Messages, DBTools, CtrlTools;

function SetObjectProperty(Instance: TPersistent; const PropName: string; Value: TObject): TObject;
var
  PropInfo: PPropInfo;
begin
  Result := nil;
  PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, PropName);
  if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then
  begin
    Result := TObject(GetOrdProp(Instance, PropInfo));
    SetObjectProp(Instance, PropInfo, Value);
  end;
end;

function PtrToValorTabla( p: pointer ): TValorTabla;
begin
  result := TValorTabla(p);
end;

function ValorTablaToPtr( v : TValorTabla ): pointer;
var
  nv : TValorTabla;
begin
  fillchar(nv,SizeOf(nv),0);
  nv := v;
  result := pointer(nv);
end;

Procedure SkinDataAssign(unControl:TComponent;SkinData:TbsSkinData);
var
  i : integer;
begin
  SetObjectProperty(unControl,'SkinData',SkinData);
  SetObjectProperty(unControl,'CtrlSkinData',SkinData);
  SetObjectProperty(unControl,'MenuSkinData',SkinData);
  SetObjectProperty(unControl,'DlgSkinData',SkinData);
  SetObjectProperty(unControl,'DlgCtrlSkinData',SkinData);
  with unControl do
    for i := 0 to ComponentCount-1 do
      SkinDataAssign(Components[i],SkinData);
  if unControl is TWinControl then
    with unControl as TWinControl do
      for i := 0 to ControlCount-1  do
        SkinDataAssign(Controls[i],SkinData);
end;

function SkinComboBoxToStr( cb: TbsSkinCustomComboBox; const default: string= '' ): string;
begin
  with cb do
    if ItemIndex>=0 then result := Items[ItemIndex]
                    else result := default;
end;

procedure StrToSkinComboBox( cb: TbsSkinCustomComboBox; const val: string; default: integer= -1 );
var
  i : integer;
begin
  with cb do
  begin
    i := Items.IndexOf(val);
    if i>=0 then ItemIndex := i
            else ItemIndex := default
  end;
end;

function SkinComboBoxToObject( cb: TbsSkinCustomComboBox; const default: pointer= nil ): pointer;
begin
  with cb do
    if ItemIndex>=0 then result := Items.Objects[ItemIndex]
                    else result := default;
end;

procedure ObjectToSkinComboBox( cb: TbsSkinCustomComboBox; obj: pointer; default: integer= -1 );
var
  i : integer;
begin
  with cb do
  begin
    i := Items.IndexOfObject(obj);
    if i>=0 then ItemIndex := i
            else ItemIndex := default
  end;
end;

function SkinComboBoxToInteger( cb: TbsSkinCustomComboBox; const default: integer= 0 ): integer;
begin
  with cb do
    if ItemIndex>=0 then result := integer(Items.Objects[ItemIndex])
                    else result := default;
end;

procedure IntegerToSkinComboBox( cb: TbsSkinCustomComboBox; val: integer; default: integer= -1 );
var
  i : integer;
begin
  with cb do
  begin
    i := Items.IndexOfObject(pointer(val));
    if i>=0 then ItemIndex := i
            else ItemIndex := default
  end;
end;

function SkinComboBoxToValorTabla( cb: TbsSkinCustomComboBox; const default: TValorTabla= '' ): TValorTabla;
begin
  with cb do
    if ItemIndex>=0 then result := PtrToValorTabla(Items.Objects[ItemIndex])
                    else result := default;
end;

procedure ValorTablaToSkinComboBox( cb: TbsSkinCustomComboBox; val: TValorTabla; default: integer= -1 );
var
  i : integer;
begin
  with cb do
  begin
    i := Items.IndexOfObject(ValorTablaToPtr(val));
    if i>=0 then ItemIndex := i
            else ItemIndex := default
  end;
end;

type
  TMibsBusinessSkinForm = class(TComponent)
  public
    FClientWidth, FClientHeight: Integer;
    FHideCaptionButtons: Boolean;
    FAlwaysShowInTray: Boolean;
    FLogoBitMapTransparent: Boolean;
    FLogoBitMap: TBitMap;
    FAlwaysMinimizeToTray: Boolean;
    FIcon: TIcon;
  end;

  TMibsSkinComboBox = class(TbsSkinComboBox)
  public
    property PopupListBox: TbsPopupListBox read FListBox;
    property Canvas;
  end;

procedure ClearBusinessSkinFormIcon(b: TbsBusinessSkinForm);
begin
  FreeAndNil(TMibsBusinessSkinForm(b).FIcon);
end;

function  SkinDBGridStateToStr( DBGrid: TbsSkinDbgrid ): string;
var
  s : string;
  c : integer;
begin
  s := '';
  with DBGrid.Columns do
    for c := 0 to Count-1 do
      if Items[c].Visible then
      begin
        AddParam(',',Items[c].Fieldname,s);
        AddParam(',',IntToStr(Items[c].Width),s);
        AddParam(',',IntToStr(Items[c].index),s);
      end;
  result := s;
end;

procedure StrToSkinDBGridState( DBGrid: TbsSkinDbgrid; var s: string );
type
  Pregdatos = ^RegDatos;
  RegDatos = record
    Campo   : String;
    display : integer;
    indice  : integer;
  end;
var
  c,i : integer;
  reg_datos  : Pregdatos;
  ListaDatos : Tlist;
  procedure Limpiar_lista(L:Tlist);
  var
    i : integer; P : pointer;
  begin
    for i :=0 to (L.Count-1) do
    begin
      p:=L.Items[i];  dispose(p);
    end;
    L.Free;
  end;
begin
  ListaDatos := TList.Create;
  with DBGrid.Columns do
  begin
    c := 0;
    while (s>'') and (c<=Count-1) do {guardo datos en la lista}
      with Items[c] do
      begin
        if Visible then
        begin
          new(reg_datos);
          reg_datos^.Campo   := GetParam(',',s);
          reg_datos^.display := StrToIntDef(GetParam(',',s),Width);
          reg_datos^.indice  := StrToIntDef(GetParam(',',s),Index);
          ListaDatos.Add(reg_datos);
        end;
        inc(c);
      end;
    i := 0;
    while i<=(ListaDatos.Count-1) do {recorro la lista para asignar datos}
    begin
      reg_datos := ListaDatos.Items[i];
      c := 0;
      while (c<=Count-1) do
      begin
        with Items[c] do
        begin
          If Visible and (FieldName=reg_datos^.Campo) then
          begin
            Width := reg_datos^.display;
            Index := reg_datos^.indice;
            c := Count;
          end;
        end;
        inc(c);
      end;
      inc(i);
    end;
  end;
  Limpiar_lista(ListaDatos);
end;

procedure SetSkinComboBoxDropWidth(CB: TbsSkinComboBox);
var i,k,max:Integer;
begin
  with TMibsSkinComboBox(CB) do
  begin
    //max := ListBoxWidth;
    max := Width;
    for i := 0 to Items.Count-1 do
    begin
      k := Canvas.TextWidth(Items[i])+20;
      if k>max then max := k;
    end;
    ListBoxWidth := max;
  end;
end;

procedure CopySkinDBGridToClipboard( Grid: TbsSkinCustomDBGrid );
var
  d : TDataset;
begin
  Clipboard.Open;
  if  Grid is TbsSkinCustomDBGrid   then d := Grid.Datasource.Dataset
  else d := nil;
  if d<>nil then CopyTableToClipboard(d);
  Clipboard.Assign(GetControlImage(Grid));
  Clipboard.Close;
end;

Procedure ObtenerPosicionesCentrado(rec:Trect;ancho,alto:integer; var posLeft,PosTop:integer);
var
  HiRec, wiRec : integer;
begin
  wiRec:= Rec.Right-Rec.Left;
  HiRec:= Rec.Bottom-Rec.Top;
  PosLeft:= Trunc((wiRec-ancho)/2);
  PosTop:= Trunc((HiRec-Alto)/2);
end;

function FindAction( al: TActionList; na: string ): integer;
begin
  for result := 0 to al.ActionCount-1 do
    with al.Actions[result] do
      if UpperCase(Name)=UpperCase(na) then exit;
  result := -1;
end;

procedure MakeToolBar( TBMain: TbsSkinToolbar; ALMain: TActionList; def: string );
var
  na : string;
  ia,po : integer;
  locked : boolean;
begin
  if TBMain.HandleAllocated then
  begin
    LockWindowUpdate(TBMain.Handle);
    Locked := true;
  end;
  TBMain.DisableAlign;
  TBMain.Images := ALMain.Images;
  TBMain.DestroyComponents;
  while def>'' do
  begin
    na := GetParam(',',def);
    with TBMain do
      if ControlCount>0 then po := Controls[ControlCount-1].Left+Controls[ControlCount-1].Width
                        else po := 0;
    if na='-' then
      with TbsSkinBevel.Create(TBMain) do
      begin
        Align := alLeft;
        Left := po;
        Width := 8;
        //Shape := bsSpacer;
        DividerMode := true;
        Parent := TBMain;
        SkinData := TBMain.SkinData;
      end
    else
    begin
      ia := FindAction(ALMain,na);
      if ia>=0 then
      begin
        if ALMain.Actions[ia].Tag=0 then
          with TbsSkinSpeedButton.Create(TBMain) do
          begin
            //Transparent := true;
            Left := po;
            Flat := true;
            //SkinDataName := 'bigtoolbutton';
            ShowCaption := false;
            Align := alLeft;
            Action := ALMain.Actions[ia];
            Glyph := nil;
            ImageIndex := (ALMain.Actions[ia] as TAction).ImageIndex;
            Parent := TBMain;
            SkinData := TBMain.SkinData;
            Width := Height;
            ParentShowHint := true;
          end
        else
          with TbsSkinMenuSpeedButton.Create(TBMain) do
          begin
            //Transparent := true;
            //TrackButtonMode := true;
            Left := po;
            //Width := Width+10;
            //SkinDataName := 'bigtoolbutton';
            Flat := true;
            ShowCaption := false;
            Align := alLeft;
            Action := ALMain.Actions[ia];
            Glyph := nil;
            ImageIndex := (ALMain.Actions[ia] as TAction).ImageIndex;
            Parent := TBMain;
            SkinData := TBMain.SkinData;
            Width := Height+10;
            ParentShowHint := true;
          end
      end;
    end;
  end;
  TBMain.EnableAlign;
  if Locked then LockWindowUpdate(0);
end;

function ToolBarDefinition( TBMain: TbsSkinToolbar ): string;
var
  i : integer;
  a : string;
begin
  result := '';
  with TBMain do
    for i := 0 to ControlCount-1 do
    begin
      if      Controls[i] is TbsSkinBevel       then a := '-'
      else if Controls[i] is TbsSkinSpeedButton then a := TbsSkinSpeedButton(Controls[i]).Action.Name
                                                else a := '';
      if a>'' then AddParam(',',a,result);
    end;
end;

function FindToolBarButton(TBMain: TbsSkinToolbar; a: TBasicAction): TbsSkinSpeedButton;
var
  i : integer;
begin
  for i := 0 to TBMain.ControlCount-1 do
    if (TBMain.Controls[i] is TbsSkinSpeedButton) and
       ((TBMain.Controls[i] as TbsSkinSpeedButton).Action=a) then
    begin
      result := (TBMain.Controls[i] as TbsSkinSpeedButton);
      exit;
    end;
  result := nil;
end;

procedure SkinStringGridToStrings( Grid: TBsSkinStringGrid; s: TStrings; OnlySelection: boolean= false );
var
  f,c : integer;
  x   : string;
  r   : TGridRect;
begin
  with Grid do
  begin
    if OnlySelection then r := Selection
    else
      with r do
      begin
        Left   := 0;
        Top    := 0;
        Right  := ColCount-1;
        Bottom := RowCount-1;
      end;
    for f := r.Top to r.Bottom do
    begin
      x := '';
      for c := r.Left to r.Right do
        if c=r.Left then x := Cells[c,f]
                    else x := x+#9+Cells[c,f];
      s.Add(x);
    end;
  end;
end;

procedure CopySkinStringGridToClipboard( Grid: TbsSkinStringGrid; OnlySelection: boolean= false );
var
  s : TStringList;
  t : pchar;
begin
  s := TStringList.Create;
  SkinStringGridToStrings(Grid,s,OnlySelection);
  t := s.GetText;
  Clipboard.Open;
  Clipboard.SetTextBuf(t);
  Clipboard.Assign(GetControlImage(Grid));
  Clipboard.Close;
  s.Free;
  StrDispose(t);
end;

end.
